home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / phigs / ptk.lha / ptk / fortran / source / library / phin.f < prev    next >
Encoding:
Text File  |  1992-06-18  |  8.2 KB  |  250 lines
  1. C----------------------------------------------------------------------------
  2.  
  3. C Module name: Phinter.
  4.  
  5. C Author: Toby Howard.
  6.  
  7. C Function: PHIGS textual interpreter.
  8.  
  9. C Internal function list: readstring, readinteger, readreal,
  10. C readphigsenum, interpreter, popenphigs.
  11.  
  12. C External function list: ptk_phinter.
  13.  
  14. C Hashtables used: "structureid".
  15.  
  16. C Modification history: (Version), (Date), (Name), (Description).
  17.  
  18. C  1.0, May 1986, Toby Howard, First version.
  19.  
  20. C 1.1, Jan 1988, Manjula Patel, PHIGS+ additions.
  21.  
  22. C 1.2, 14th July 1988, Steve Larkin, Modified to use Vax PHIGS$
  23. C and a pascal binding in 'pbind.pas'.
  24.  
  25. C 2.0, May 1991, Gareth Williams, Converted to C.
  26.  
  27. C 2.1, June 1991, Gareth Williams, Completed handling of all PHIGS functions.
  28.  
  29. C----------------------------------------------------------------------------
  30.  
  31.        SUBROUTINE ptkf_phinter(input, outputscript, informscript)
  32. C /*
  33. C ** \parambegin
  34. C ** \param{INTEGER}{input}{file pointer for input script}{IN}
  35. C ** \param{INTEGER}{output}{file pointer for output script}{OUT}
  36. C ** \param{INTEGER}{inform}{file pointer for information such as results of
  37. C ** inquiry calls.}{OUT}
  38. C ** \paramend
  39. C ** \blurb{This function reads a PHIGS script from a file or from standard
  40. C ** input. If {\tt stdin} is passed as the input file pointer then
  41. C ** phinter becomes interactive and prompts are given for function
  42. C ** parameters. The other file pointers are used for writing an output 
  43. C ** script and for writing data which
  44. C ** results from inquiry calls and so on.}
  45. C */
  46.        INTEGER input, outputscript, informscript
  47.        external ptk_phinter !$PRAGMA C(ptk_phinter)
  48.  
  49.        call ptk_phinter(%val(input), 
  50. & %val(outputscript), %val(informscript))
  51.  
  52.        RETURN
  53.        END
  54.  
  55.        SUBROUTINE ptkf_strphinter(wsid, echoarea, outputterminal, 
  56. & informterminal)
  57. C /*
  58. C ** \parambegin
  59. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  60. C ** \param{REAL}{echo area(4)}{echo area for string device}{IN}
  61. C ** \param{INTEGER}{outputterminal}{terminal window identifier for writing
  62. C ** output script to}{IN}
  63. C ** \param{INTEGER}{informterminal}{terminal window identifier for writing
  64. C ** information data}{IN}
  65. C ** \paramend
  66. C ** \blurb{This function redirects the input of phinter to the PHIGS string 
  67. C ** device (number 1). Strphinter is always interactive and output is 
  68. C ** directed
  69. C ** to terminal windows instead of files so that it may be displayed in the
  70. C ** PHIGS workstation window.}
  71. C */
  72.        INTEGER wsid
  73.        REAL echoarea(4)
  74.        INTEGER outputterminal, informterminal
  75.        external ptk_strphinter !$PRAGMA C(ptk_strphinter)
  76.  
  77.        call ptk_strphinter(%val(wsid), echoarea, %val(outputterminal), 
  78. & %val(informterminal))
  79.  
  80.        RETURN
  81.        END
  82.  
  83.        LOGICAL FUNCTION ptkf_readphinterscript(scriptname, output, 
  84. & inform)
  85. C /*
  86. C ** \parambegin
  87. C ** \param{CHARACTER*(*)}{scriptname}{script filename}{IN}
  88. C ** \param{INTEGER}{output}{output script file pointer}{OUT}
  89. C ** \param{INTEGER}{inform}{information script file pointer}{OUT}
  90. C ** \paramend
  91. C ** \blurb{This function reads a PHIGS script from the file specified
  92. C ** by {\tt scriptname}. The file is automatically opened and closed
  93. C ** and the function returns TRUE if a PHIGS script has been successfully 
  94. C ** read.}
  95. C */
  96.        CHARACTER*(*) scriptname
  97.        INTEGER output, inform
  98.        LOGICAL*1 ptk_readphinterscript, ans
  99.        external ptk_readphinterscript 
  100. & !$PRAGMA C(ptk_readphinterscript)
  101.  
  102.        ans = ptk_readphinterscript(scriptname, %val(output),
  103. & %val(inform))
  104.        if (ans .eq. 1) then
  105.           ptkf_readphinterscript = .TRUE.
  106.        else
  107.           ptkf_readphinterscript = .FALSE.
  108.        endif
  109.  
  110.        RETURN
  111.        END
  112.  
  113.        SUBROUTINE ptkf_writestruct(fileptr, num, stids)
  114. C /*
  115. C ** \parambegin
  116. C ** \param{INTEGER}{fileptr}{pointer to file}{OUT}
  117. C ** \param{INTEGER}{num}{number of structures}{IN}
  118. C ** \param{INTEGER}{stids(*)}{structure identifier list}{IN}
  119. C ** \paramend
  120. C ** \blurb{This function writes the contents of a list of structures 
  121. C ** to a file. The structures are written in the PHIGS script format so that
  122. C ** they may be read in again using {\tt ptk\_phinter}.}
  123. C */
  124.        INTEGER fileptr, num, stids(num)
  125.        external ptkc_writestruct !$PRAGMA C(ptkc_writestruct)
  126.  
  127.        call ptkc_writestruct(%val(fileptr), %val(num), 
  128. & stids)
  129.  
  130.        RETURN
  131.        END
  132.  
  133.        SUBROUTINE ptkf_writestructnet(fileptr, num, stids)
  134. C /*
  135. C ** \parambegin
  136. C ** \param{INTEGER}{fileptr}{pointer to file}{OUT}
  137. C ** \param{INTEGER}{num}{number of structures}{IN}
  138. C ** \param{INTEGER}{stids(*)}{structure network identifier list}{IN}
  139. C ** \paramend
  140. C ** \blurb{This function writes the contents of a list of structure networks 
  141. C ** to a file. The structures are written in the PHIGS script format so that
  142. C ** they may be read in again using {\tt ptk\_phinter}.}
  143. C */
  144.        INTEGER fileptr, num, stids(num)
  145.        external ptkc_writestructnet !$PRAGMA C(ptkc_writestructnet)
  146.  
  147.        call ptkc_writestructnet(%val(fileptr), %val(num), 
  148. & stids)
  149.  
  150.        RETURN
  151.        END
  152.  
  153.        SUBROUTINE ptkf_writeallstruct(fileptr)
  154. C /*
  155. C ** \parambegin
  156. C ** \param{INTEGER}{fileptr}{pointer to file}{OUT}
  157. C ** \paramend
  158. C ** \blurb{This function writes the contents of all the structures in the
  159. C ** PHIGS CSS to a file. The structures are written in the PHIGS script 
  160. C ** format so that they may be read in again using {\tt ptk\_phinter}.}
  161. C */
  162.        INTEGER fileptr
  163.        external ptk_writeallstruct !$PRAGMA C(ptk_writeallstruct)
  164.  
  165.        call ptk_writeallstruct(%val(fileptr))
  166.  
  167.        RETURN
  168.        END
  169.  
  170.        SUBROUTINE ptkf_readelem(ws, echoarea, eltype)
  171. C /*
  172. C ** \parambegin
  173. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  174. C ** \param{REAL}{echo area(4)}{echo area for string device}{IN}
  175. C ** \param{INTEGER}{eltype}{element type to read in}{IN}
  176. C ** \paramend
  177. C ** \blurb{This function reads the contents of a PHIGS element from the 
  178. C ** PHIGS string device (number 1). Prompts are given for the required data
  179. C ** depending on the element type. An element with the input data is inserted
  180. C ** into the currently open structure at the current editing position.}
  181. C */
  182.        INTEGER ws
  183.        REAL echoarea(4)
  184.        INTEGER eltype
  185.        external ptk_readelem !$PRAGMA C(ptk_readelem)
  186.  
  187.        call ptk_readelem(%val(ws), echoarea, %val(eltype))
  188.  
  189.        RETURN
  190.        END
  191.  
  192.        SUBROUTINE ptkf_callphinter()
  193. ** \blurb{This function provides an interface to phinter and its related
  194. ** functions. The available commands are as follows:
  195. ** \begin{description}
  196. ** \item[help]{output this list.}
  197. ** \item[interactive]{call phinter with stdin for input script.}
  198. ** \item[stringinput]{call phinter using string device for input 
  199. ** and terminal windows for output.}
  200. ** \item[read]{call phinter with a given input script.}
  201. ** \item[outputfile]{set output script filename.}
  202. ** \item[informfile]{set information filename.}
  203. ** \item[outputterm]{set output terminal window identifier.}
  204. ** \item[informterm]{set information terminal window identifier.}
  205. ** \item[writestruct]{write contents of structures to output file.}
  206. ** \item[writestruct]{write contents of structure networks
  207. ** to output file.}
  208. ** \item[writestruct]{write contents of all structures to
  209. ** output file.}
  210. ** \item[quit or exit]{leave callphinter.}
  211. ** \end{description}\ 
  212. ** }
  213. */
  214.        external ptk_callphinter !$PRAGMA C(ptk_callphinter)
  215.  
  216.        call ptk_callphinter()
  217.  
  218.        RETURN
  219.        END
  220.  
  221.        LOGICAL FUNCTION ptkf_elemcontent(stid, elemid, termid, error)
  222. C /* 
  223. C ** \parambegin
  224. C ** \param{INTEGER}{stid}{structure identifier}{IN}
  225. C ** \param{INTEGER}{elemid}{element number}{IN}
  226. C ** \param{INTEGER}{termid}{terminal window identifier}{IN}
  227. C ** \param{INTEGER}{error}{error code}{OUT}
  228. C ** \paramend
  229. C ** \blurb{This function writes the contents of an element in a 
  230. C ** terminal window. If the element is an output primitive then
  231. C ** it is inserted into the currently open structure at the current
  232. C ** editing position and the function returns TRUE, otherwise FALSE.}
  233. C */
  234.        INTEGER stid, elemid, termid, error
  235.        LOGICAL*1 ptk_elemcontent, ans
  236.        external ptk_elemcontent !$PRAGMA C(ptk_elemcontent)
  237.  
  238.        ans = ptk_elemcontent(%val(stid), %val(elemid), %val(termid), 
  239. & error)
  240.        if (ans .eq. 1) then
  241.           ptkf_elemcontent = .TRUE.
  242.        else
  243.           ptkf_elemcontent = .FALSE.
  244.        endif
  245.  
  246.        RETURN
  247.        END
  248.  
  249. C end of phin.f
  250.